Aminet 2/Aminet AMIGA CDROM (1994)(Walnut Creek)[Feb 1994][W.O. 44790-1].iso/Aminet/dev/lang/PCQ12src.lzh/Source/StanProcs.p

Text File | 1991-04-16 | 21KB | 850 lines

External;

{
    Stanprocs.p (of PCQ Pascal)
    Copyright (c) 1989 Patrick Quaid

    This routine implements the various standard procedures,
    hence the name.
}

{$O-}
{$I "Pascal.i"}

    Procedure NextSymbol;
        external;
    Function Match(s : Symbols): Boolean;
        external;
    Procedure Error(s : string);
        external;
    Function Expression : TypePtr;
        external;
    Function ConExpr(VAR t : TypePtr): Integer;
        external;
    Function GetReference : ExprPtr;
        External;
    Procedure EvalAddress(Expr : ExprPtr; ToReg : Regs);
        External;
    Function SimpleReference(Expr : ExprPtr) : Boolean;
        External;
    Procedure FreeAllRegisters;
        External;
    Procedure MarkRegister(Reg : Regs);
        External;
    Procedure Optimize(Expr : ExprPtr);
        External;
    Function TypeCmp(t1, t2 : TypePtr): Boolean;
        external;
    Function TypeCheck(t1, t2 : TypePtr): Boolean;
        external;
    Function LoadAddress : TypePtr;
        external;
    Procedure Mismatch;
        external;
    Procedure UsingSmallStartup;
        External;
    Procedure NeedLeftParent;
        external;
    Procedure NeedRightParent;
        external;
    Procedure NeedNumber;
        external;
    Function FindID(s : string) : IDPtr;
        external;
    Function FindWithField(s : String) : IDPtr;
        External;
    Procedure SaveStack(TP : TypePtr);
        external;
    Procedure SaveVal(ID : IDPtr);
        external;
    Procedure ns;
        external;
    Procedure PromoteType(var f : TypePtr; o : TypePtr; r : Short);
        external;
    Function NumberType(t : TypePtr): Boolean;
        external;
    Procedure PushLongD0;
        external;
    Procedure PushWordD0;
        external;
    Procedure PopLongD1;
        external;
    Procedure PopStackSpace(amount : Integer);
        External;
    Procedure PushLongA0;
        External;
    Function Suffix(size : Integer) : Char;
        External;
    Procedure AddConstant(Amount : Integer; ToReg : Regs; Size : Byte);
        External;
    Function PromoteTypeA(Expr : ExprPtr; TP : TypePtr) : ExprPtr;
        External;
    Function ExpressionTree : ExprPtr;
        External;
    Procedure Evaluate(Expr : ExprPtr; ToReg : Regs);
        External;
    Procedure Out_Operation0(op : OpCodes);
        External;
    Procedure Out_Operation1(op : OpCodes; Size : Byte;
                    EA : EAModes; Reg : Regs);
        External;
    Procedure Out_Operation2(op : OpCodes; Size : Byte;
                    SrcEA : EAModes; SrcReg : Regs;
                    DestEA : EAModes; DestReg : Regs);
        External;
    Procedure Out_Extension(Ext : Integer);
        External;
    Procedure WriteSimpleDest(Expr : ExprPtr; op : OpCodes; Size : Byte;
                SrcEA : EAModes; SrcReg : Regs;
                SExt1, SExt2 : Integer);
        External;



Procedure CallCheckIO;
begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%CheckIO"));
end;

Procedure CallWrite(TP : TypePtr);

{
    This routine calls the appropriate library routine to write
vartype to a text file.
}

var
    ElementType    : TypePtr;
begin
    if TypeCmp(TP, RealType) then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%WriteReal"));
    end else if NumberType(TP) then begin
    PromoteType(TP, IntType, 0);
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%WriteInt"));
    end else if TypeCmp(TP, CharType) then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%WriteChar"));
    end else if TypeCmp(TP, BoolType) then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%WriteBool"));
    end else if TP^.Object = ob_array then begin
    ElementType := TP^.SubType;
    if TypeCmp(ElementType, CharType) then begin
        Out_Operation2(op_MOVE,4,ea_Constant,a7,ea_Register,d3);
        Out_Extension(Succ(TP^.Upper - TP^.Lower));
        Out_Operation1(op_JSR,3,ea_String,a7);
        Out_Extension(Integer("_p%WriteCharray"));
    end else
        Error("Write() can only write arrays of char");
    end else if TP = StringType then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%WriteString"));
    end else
    Error("can't write that type to text file");
    if IOCheck then
    CallCheckIO;
    MathLoaded := False;
end;

Procedure FileWrite(TP : TypePtr);

{
    This routine writes a variable to a File of TP
}

begin
    Out_Operation2(op_MOVE,4,ea_Constant,a7,ea_Register,d3);
    Out_Extension(TP^.Size);
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%WriteArb"));
    if IOCheck then
    CallCheckIO;
    MathLoaded := False;
end;

Procedure DoWrite(ID : IDPtr);

{
    This routine handles all aspects of the write and writeln
statements.
}

var
    FileType    : TypePtr; { file type if there is one }
    ExprType    : TypePtr; { current element type }
    Pushed    : Boolean; { have pushed the file handle on stack }
    Width    : Integer; { constant field width }
    WidType     : TypePtr; { type of the above }
begin
    if SmallInitialize then
    UsingSmallStartup;
    if Match(LeftParent1) then begin
    FileType := Expression();
    Pushed := True;
    if FileType^.Object = ob_file then
        PushLongD0
    else begin
        Out_Operation1(op_PUSH,4,ea_String,a7);
        Out_Extension(Integer("#_Output"));
        StackLoad := StackLoad + 4;
        if Match(colon1) then begin
        PushLongD0;
        WidType := Expression();
        if not TypeCheck(IntType, WidType) then
            NeedNumber
        else
            PromoteType(WidType,ShortType,0);
        PopLongD1;
        PushWordD0;
        Out_Operation2(op_MOVE,4,ea_Register,d1,ea_Register,d0);
        end else begin
        Out_Operation1(op_PUSH,2,ea_Constant,a7);
        Out_Extension(0);
        StackLoad := StackLoad + 2;
        end;
        if TypeCmp(FileType, RealType) then begin
        if Match(colon1) then begin
            PushLongD0;
            WidType := Expression();
            if not TypeCheck(IntType, WidType) then
            NeedNumber
            else
            PromoteType(WidType,ShortType,0);
            PopLongD1;
            PushWordD0;
            Out_Operation2(op_MOVE,4,ea_Register,d1,ea_Register,d0);
        end else begin
            Out_Operation1(op_PUSH,2,ea_Constant,a7);
            Out_Extension(2);
            StackLoad := StackLoad + 2;
        end;
        end;
        CallWrite(FileType);
        if TypeCmp(FileType, RealType) then
        PopStackSpace(4)
        else
        PopStackSpace(2);
        FileType := TextType;
    end;
    while not Match(RightParent1) do begin
        if not Match(Comma1) then
        Error("expecting , or )");
        ExprType := Expression();
        if FileType = TextType then begin
        if Match(Colon1) then begin
            PushLongD0;
            WidType := Expression();
            if not TypeCheck(IntType, WidType) then
            NeedNumber
            else
            PromoteType(WidType,ShortType,0);
            PopLongD1;
            PushWordD0;
            Out_Operation2(op_MOVE,4,ea_Register,d1,ea_Register,d0);
        end else begin
            Out_Operation1(op_PUSH,2,ea_Constant,a7);
            Out_Extension(0);
            StackLoad := StackLoad + 2;
        end;
        if TypeCmp(ExprType, RealType) then begin
            if Match(colon1) then begin
            PushLongD0;
            WidType := Expression();
            if not TypeCheck(IntType, WidType) then
                NeedNumber
            else
                PromoteType(WidType,ShortType,0);
            PopLongD1;
            PushWordD0;
            Out_Operation2(op_MOVE,4,ea_Register,d1,ea_Register,d0);
            end else begin
            Out_Operation1(op_PUSH,2,ea_Constant,a7);
            Out_Extension(2);
            StackLoad := StackLoad + 2;
            end;
        end;
        CallWrite(ExprType);
        if TypeCmp(ExprType, RealType) then
            PopStackSpace(4)
        else
            PopStackSpace(2);
        end else begin
        if TypeCmp(FileType^.SubType, ExprType) then
            FileWrite(ExprType)
        else
            Mismatch;
        end;
    end;
    end else begin
    FileType := TextType;
    Pushed := False;
    if ID^.Offset = 1 then
        error("'write' requires arguments.");
    end;
    if ID^.Offset = 2 then begin
    if FileType = TextType then begin
        if Pushed then begin
        Out_Operation1(op_JSR,3,ea_String,a7);
        Out_Extension(Integer("_p%WriteLn"));
        end else begin
        Out_Operation1(op_PUSH,4,ea_String,a7);
        Out_Extension(Integer("#_Output"));
        Out_Operation1(op_JSR,3,ea_String,a7);
        Out_Extension(Integer("_p%WriteLn"));
        AddConstant(4, a7, 4);
        end;
        if IOCheck then
        CallCheckIO;
    end else
       error("Writeln is only for text files");
    end;
    if Pushed then
    PopStackSpace(4);
end;

Procedure CallRead(TP : TypePtr);

{
    This routine calls the appropriate library routines to read
the vartype from a text file.
}

begin
    if TypeCmp(TP, CharType) then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%ReadChar"));
    end else if TypeCmp(TP, IntType) then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%ReadInt"));
    Out_Operation2(op_MOVE,4,ea_Register,d0,ea_Indirect,a0);
    end else if TypeCmp(TP, ShortType) then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%ReadInt"));
    Out_Operation2(op_MOVE,2,ea_Register,d0,ea_Indirect,a0);
    end else if TypeCmp(TP, ByteType) then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%ReadInt"));
    Out_Operation2(op_MOVE,1,ea_Register,d0,ea_Indirect,a0);
    end else if TypeCmp(TP, RealType) then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%ReadReal"));
    end else if TP^.Object = ob_array then begin
    if TypeCmp(TP^.SubType, chartype) then begin
        Out_Operation2(op_MOVE,4,ea_Constant,a7,ea_Register,d3);
        Out_Extension(Succ(TP^.Upper - TP^.Lower));
        Out_Operation1(op_JSR,3,ea_String,a7);
        Out_Extension(Integer("_p%ReadCharray"));
    end else
        Error("can only read character arrays");
    end else if TP = StringType then begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%ReadString"));
    end else
    Error("cannot read that type from a text file");
    if IOCheck then
    CallCheckIO;
    MathLoaded := False; { Overwritten by DOSBase }
end;

Procedure DoRead(ID : IDPtr);

{
    This handles the read statement.  Note that read(f, var) from a
non-text file really does end up being var := f^; get(f).  Same
goes for text files, but it's all handled within the library.
    Note the difference between this and dowrite(),
specifically the use of expression() up there and loadaddress()
here.
}

var
    FileType,
    VarType    : TypePtr;
    Pushed    : Boolean;
begin
    if SmallInitialize then
    UsingSmallStartup;
    if Match(LeftParent1) then begin
    FileType := LoadAddress();
    Pushed := True;
    if FileType^.Object = ob_file then
        PushLongA0
    else begin
        Out_Operation1(op_PUSH,4,ea_String,a7);
        Out_Extension(Integer("#_Input"));
        StackLoad := StackLoad + 4;
        CallRead(FileType);
        FileType := TextType;
    end;
    while not Match(RightParent1) do begin
        if not Match(Comma1) then
        Error("expecting , or )");
        VarType := LoadAddress();
        if FileType = TextType then
        CallRead(VarType)
        else begin
        if TypeCmp(FileType^.SubType, VarType) then begin
            Out_Operation1(op_JSR,3,ea_String,a7);
            Out_Extension(Integer("_p%ReadArb"));
        end else
            Mismatch;
        if IOCheck then
            CallCheckIO;
        end;
    end;
    end else begin
    FileType := TextType;
    Pushed := False;
    if ID^.Offset = 3 then
        error("'read' requires arguments.");
    end;
    if ID^.Offset = 4 then begin
    if TypeCmp(FileType, TextType) then begin
        if Pushed then begin
        Out_Operation1(op_JSR,3,ea_String,a7);
        Out_Extension(Integer("_p%ReadLn"));
        end else begin
        Out_Operation1(op_PUSH,4,ea_String,a7);
        Out_Extension(Integer("#_Input"));
        Out_Operation1(op_JSR,3,ea_String,a7);
        Out_Extension(Integer("_p%ReadLn"));
        AddConstant(4, a7, 4);
        end;
        if IOCheck then
        CallCheckIO;
    end else
       error("Readln applies only to Text files");
    end;
    if Pushed then
    PopStackSpace(4);
end;

Procedure DoNew;

{
    This just handles allocation of memory.
}

var
    Expr    : ExprPtr;
begin
    NeedLeftParent;
    NextFreeExprNode := 0;
    ConstantExpression := False;
    Expr := GetReference;
    Optimize(Expr);
    if Expr^.EType^.Object <> ob_pointer then
    Error("Expecting a pointer type")
    else begin
    Out_Operation2(op_MOVE,4,ea_Constant,a7,ea_Register,d0);
    Out_Extension(Expr^.EType^.SubType^.Size);
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%new"));

    if SimpleReference(Expr) then begin
        WriteSimpleDest(Expr, op_MOVE,4,ea_Register,d0,0,0);
    end else begin
        FreeAllRegisters;
        MarkRegister(d0);
        EvalAddress(Expr, a0);
        Out_Operation2(op_MOVE,4,ea_Register,d0,ea_Indirect,a0);
    end;
    end;
    NeedRightParent;
    MathLoaded := False;
    if SmallInitialize then
    UsingSmallStartup;
end;

Procedure DoDispose;

{
    This routine calls the library routine that frees memory.
}

var
    ExprType    : TypePtr;
begin
    NeedLeftParent;
    ExprType := Expression();
    if ExprType^.Object <> ob_pointer then
    Error("Expecting a pointer type")
    else begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%dispose"));
    end;
    NeedRightParent;
    MathLoaded := False;
    if SmallInitialize then
    UsingSmallStartup;
end;

Procedure DoClose;

{
    Closes a file.  The difference between this and a normal
DOS close is that this routine must un-link the file from the
program's open file list.
}

var
    ExprType    : TypePtr;
begin
    NeedLeftParent;
    ExprType := LoadAddress();
    if ExprType^.Object <> ob_file then
    Error("Expecting a file type")
    else begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%Close"));
    end;
    if IOCheck then
    CallCheckIO;
    NeedRightParent;
    MathLoaded := False;
    if SmallInitialize then
    UsingSmallStartup;
end;

Procedure DoGet;

{
    This implements get.
}

var
    ExprType    : TypePtr;
begin
    NeedLeftParent;
    ExprType := LoadAddress();
    if ExprType^.Object <> ob_file then
    Error("Expecting a file type")
    else begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%Get"));
    end;
    if IOCheck then
    CallCheckIO;
    NeedRightParent;
    MathLoaded := False;
    if SmallInitialize then
    UsingSmallStartup;
end;

Procedure DoPut;

{
    This just implements put.  The real guts of these two
routines is in the runtime library.
}

var
    ExprType    : TypePtr;
begin
    NeedLeftParent;
    ExprType := LoadAddress();
    if ExprType^.Object <> ob_file then
    Error("Expecting a file type")
    else begin
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%Put"));
    end;
    if IOCheck then
    CallCheckIO;
    NeedRightParent;
    MathLoaded := False;
    if SmallInitialize then
    UsingSmallStartup;
end;

Procedure DoIncDec(op : OpCodes);

{
    This takes care of Inc.
}

var
    Dest    : ExprPtr;
    Delta    : Integer;
    Expr    : ExprPtr;
    IsSimple    : Boolean;
    DSize    : Short;
    Shifts    : Short;
begin
    NeedLeftParent;
    NextFreeExprNode := 0;
    FreeAllRegisters;
    Dest := GetReference;
    Optimize(Dest);

    with Dest^.EType^ do begin
    if Object = ob_Ordinal then begin
        Delta := 1;
        DSize := Size;
    end else if Object = ob_pointer then begin
        Delta := SubType^.Size;
        DSize := Size;
    end else begin
        Error("Expecting an ordinal or pointer type");
        DSize := 1;
        Delta := 1;
    end;
    end;

    if match(comma1) then begin
    Expr := ExpressionTree;
    if TypeCheck(Expr^.EType, IntType) then begin
        case DSize of
          2 : Expr := PromoteTypeA(Expr,ShortType);
          4 : Expr := PromoteTypeA(Expr,IntType);
        end;
        Optimize(Expr);
    end else
        MisMatch;
    end else
    Expr := Nil;

    NeedRightParent;

    IsSimple := SimpleReference(Dest);

    if not IsSimple then
    EvalAddress(Dest,a0);

    if (Expr = Nil) or (Expr^.Kind = Const1) then begin
    if Expr <> Nil then
        Delta := Expr^.Value * Delta;

    if Delta = 0 then
        return;

    if (Delta < 0) and (Delta >= -8) then begin
        Delta := -Delta;
        if Op = op_SUB then
        Op := op_ADD
        else
        Op := op_SUB;
    end;

    if (Abs(Delta) <= 127) and (Abs(Delta) > 8) then begin
        Out_Operation2(op_MOVEQ,3,ea_Constant,a7,ea_Register,d0);
        Out_Extension(Delta);
        if IsSimple then
        WriteSimpleDest(Dest, Op, DSize, ea_Register,d0,0,0)
        else
        Out_Operation2(Op, DSize, ea_Register,d0,
                            ea_Indirect,a0);
    end else if IsSimple then
        WriteSimpleDest(Dest,Op,DSize,ea_Constant,a7,Delta,0)
    else begin
        Out_Operation2(Op,DSize, ea_Constant,a7,ea_Indirect,a0);
        Out_Extension(Delta);
    end;
    end else begin { not a constant increment }
    if Expr^.EType^.Size = 1 then begin
        Expr := PromoteTypeA(Expr,ShortType);
        Optimize(Expr);
    end;
    Evaluate(Expr, d0);
    case Delta of
         1 : Shifts := 0;
         2 : Shifts := 1;
         4 : Shifts := 2;
         8 : Shifts := 3;
        16 : Shifts := 4;
        32 : Shifts := 5;
        64 : Shifts := 6;
       128 : Shifts := 7;
       256 : Shifts := 8;
       512 : Shifts := 9;
      1024 : Shifts := 10;
      2048 : Shifts := 11;
      4096 : Shifts := 12;
      8192 : Shifts := 13;
     16384 : Shifts := 14;
     32768 : Shifts := 15;
     65536 : Shifts := 16;
    else begin
             Out_Operation2(op_MULS,3,ea_Constant,a7,ea_Register,d0);
         Out_Extension(Delta);
         Shifts := -1;
         end;
    end;

    if Shifts > 7 then begin
        Out_Operation2(op_MOVEQ,3,ea_Constant,a7,ea_Register,d1);
        Out_Extension(Shifts);
        Out_Operation2(op_LSL,DSize,ea_Register,d1,ea_Register,d0);
    end else if Shifts > 0 then begin
        Out_Operation2(op_LSL,DSize,ea_Constant,a7,ea_Register,d0);
        Out_Extension(Shifts);
    end;

    if IsSimple then
        WriteSimpleDest(Dest,Op,DSize,ea_Register,d0,0,0)
    else begin
        Out_Operation2(Op, DSize, ea_Constant,a7,ea_Indirect,a0);
        Out_Extension(Delta);
    end;
    end;
end;

Procedure DoExit;

{
    Just calls the routine that allows the graceful shut-down
of the program.
}

var
    Expr : ExprPtr;
begin
    if Match(LeftParent1) then begin
    NextFreeExprNode := 0;
    ConstantExpression := False;
    Expr := ExpressionTree;
    Optimize(Expr);
    if TypeCheck(Expr^.EType, IntType) then
        Expr := PromoteTypeA(Expr, IntType)
    else
        Error("Expecting an integer argument");
    FreeAllRegisters;
    Evaluate(Expr,d0);
    NextFreeExprNode := 0;
    NeedRightParent;
    end else begin
    Out_Operation2(op_MOVEQ,3,ea_Constant,a7,ea_Register,d0);
    Out_Extension(0);
    end;
    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%exit"));
    MathLoaded := False;
end;

Procedure DoTrap;

{
    This is just for debugging a program.  Use some trap, and
your debugger will stop at that statement.
}

var
    ExprType  : TypePtr;
    TrapNum   : Integer;
begin
    NeedLeftParent;
    TrapNum := ConExpr(ExprType);
    Out_Operation1(op_TRAP,3,ea_Constant,a7);
    Out_Extension(TrapNum);
    NeedRightParent;
end;


Procedure DoFileOpen(Which : Integer);
var
    FName : ExprPtr;
    FVar  : ExprPtr;
    Buffer: ExprPtr;
    RecSize : Integer;
begin
    NeedLeftParent;
    NextFreeExprNode := 0;
    ConstantExpression := False;

    FVar := GetReference;
    if FVar^.EType^.Object = ob_file then begin
    Optimize(FVar);
    RecSize := FVar^.EType^.SubType^.Size;
    end else begin
    Error("Expecting a file type");
    RecSize := 1;
    end;

    if not match(comma1) then
    Error("Missing comma");

    FName := ExpressionTree;
    if TypeCheck(StringType,FName^.EType) then begin
    Optimize(FName);
    FreeAllRegisters;
    Evaluate(FName, d0);
    Out_Operation1(op_PUSH,4,ea_Register,d0);
    StackLoad := StackLoad + 4;
    end else
    Mismatch;

    FreeAllRegisters;
    if FVar^.EType^.Object = ob_file then
    EvalAddress(FVar, a0);

    Out_Operation2(op_MOVE,2,ea_Constant,a7,ea_Index,a0);

    if Which = 14 then        { reset - MODE_OLDFILE}
    Out_Extension(1005)
    else
    Out_Extension(1006);    { rewrite - MODE_NEWFILE}
    Out_Extension(30);        { ACCESS(a0) }

    if RecSize <= 127 then begin
    Out_Operation2(op_MOVEQ,3,ea_Constant,a7,ea_Register,d0);
    Out_Extension(RecSize);
    Out_Operation2(op_MOVE,4,ea_Register,d0,ea_Index,a0);
    end else begin
    Out_Operation2(op_MOVE,4,ea_Constant,a7,ea_Index,a0);
    Out_Extension(RecSize);
    end;
    Out_Extension(24);

    if match(comma1) then begin
    Buffer := ExpressionTree;
    if TypeCheck(Buffer^.EType,IntType) then begin
        Optimize(Buffer);
        Evaluate(Buffer,d0);
        Out_Operation2(op_MOVE,4,ea_Register,d0,ea_Index,a0);
    end else
        Mismatch;
    end else begin
    Out_Operation2(op_MOVE,4,ea_Constant,a7,ea_Index,a0);
    Out_Extension(128);
    end;
    Out_Extension(20);

    Out_Operation1(op_PUSH,4,ea_Register,a0);

    Out_Operation1(op_JSR,3,ea_String,a7);
    Out_Extension(Integer("_p%OpenB"));

    AddConstant(8, a7, 4);
    StackLoad := StackLoad - 4; { we only added for FName }
    NeedRightParent;
end;

Procedure StdProc(ProcID : IDPtr);

{
    This routine sifts out the proper routine to call.
}

begin
    NextSymbol;
    case ProcID^.Offset of
      1,2 : DoWrite(ProcID);
      3,4 : DoRead(ProcID);
      5   : DoNew;
      6   : DoDispose;
      7   : DoClose;
      8   : DoGet;
      9   : DoExit;
      10  : DoTrap;
      11  : DoPut;
      12  : DoIncDec(op_ADD);
      13  : DoIncDec(op_SUB);
      14,
      15  : DoFileOpen(ProcID^.Offset);
    end;
end;